home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb11.zip / HEAPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-13  |  2KB  |  60 lines
  1. program HeapTest(input, output);
  2.  
  3. {
  4. Source: "HEAPTEST for Turbo Pascal and FIX", TUG Lines Volume I, Issue 2
  5. Author: Hal Varian
  6. Application: Turbo Pascal version 2.0 for PC-DOS/MS-DOS
  7. }
  8.  
  9.  
  10. {This program demonstrates a bug in Turbo Pascal, version 2.
  11. I put 10 integers on the stack, then release the stack and put
  12. 10 integers on the stack again.  In v. 1.0 we get the same results
  13. each time, as we should.  In v. 2.0 we get different answers. 
  14. Apparently the procedure Release(HeapTop) is not working properly.}
  15. {The procedure ReleaseHeap is a replacement for Release(HeapTop) and
  16. seems to work correctly}
  17.  
  18. type
  19.   IntegerPointer = ^integer;
  20. var
  21.   Number :  ^integer;
  22.   HeapTop : ^integer;
  23.   Mem : real;
  24. procedure ReleaseHeap (AHeapPointer : IntegerPointer);
  25. var i : integer;
  26. begin
  27.   i := ((seg(heapptr^) - seg(AHeapPointer^)) shl 4) +
  28.         (ofs(heapptr^) - ofs(AHeapPointer^));
  29.   FreeMem(AHeapPointer,i);
  30. end;
  31. procedure report; {report memory available}
  32. begin
  33.     Mem := MemAvail;
  34.     if (Mem < 0) then Mem := 65536.0+MemAvail;
  35.     write('MemAvail = ',Mem:7:0, ' paragraphs ', Mem*16.0:9:0, ' bytes');
  36. end;
  37. procedure FillTheHeap(xc,yc,Depth : integer); {fill the heap to Depth}
  38. var
  39.   n : integer;
  40. begin
  41. for n := 1 to Depth do
  42.     begin
  43.     New(Number) ;
  44.     Number^ := n;
  45.     gotoxy(xc,yc);
  46.     report;
  47.     end
  48. end;
  49. begin
  50.     Mark(HeapTop);  {Mark the top of the heap}
  51.     gotoxy(5,20);
  52.     report;               {1: Report memory available}
  53.     FilltheHeap(5,21,10); {2: Fill the heap with 10 integers}
  54.     ReleaseHeap(HeapTop); {Release the heap using the fix}
  55.    {Release(HeapTop);      This does not work!}
  56.     gotoxy(5,22);
  57.     report;               {3: Report memory available; should be same as in 1}
  58.     FilltheHeap(5,23,10); {4: Put 10 integers on again; should be same as in 2}
  59. end.
  60.